Fortran For Fun之预处理

发表于 | 分类于

fortran预处理也是借鉴c语言，可以在头文件或程序中通过#define来预定义宏，或在编译选项中添加-D…选项来预定义。预处理通常包括

  • 文件包含

    1
    #include "..."

  • 宏定义

    1
    #define ...

  • 条件编译

    1
    2
    3
    4
    5
    #ifdef ...
      ...
    #else
      ...
    #endif

以下通过一个debug模块来说明预处理的应用。

debug

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
module debug
  use, intrinsic :: iso_fortran_env, only: output_unit, error_unit
  implicit none
  public :: set_debug_level, debug_unit, debug_error, debug_level_
  private
  integer, save :: debug_level_  = 1
contains
  !=============================================================================
  subroutine set_debug_level(level)
    !< set debug_level_, only print `level<debug_level_` information
    integer,intent(in) :: level
    debug_level_ = level
  end subroutine set_debug_level
  !=============================================================================
  function debug_unit(unit)
    !< choose where to print, level<1',print to `ERROR_UNIT`, else print to `OUTPUT_UNIT`
    integer, intent(in) :: unit
    integer :: debug_unit
    if(unit<1) then
       debug_unit = error_unit
    else
       debug_unit = output_unit
    end if
  end function debug_unit
  !=============================================================================
  subroutine debug_error(msg,file,line)
    !< print error message, contains which file and line
    character(*), intent(in) :: msg,file
    integer, intent(in) :: line
    character(8) :: ls
    write(ls,'(i0)') line
    write(error_unit,*)              '# Error'
    write(error_unit,'(1x,3a,i0,a)') 'Source loction: (' //  file//', '// trim(ls)//' )'
    write(error_unit,*)              'Error message : '//msg
    stop
  end subroutine debug_error
end module debug

该模块主要定义了一个debug_error函数以及一个debug_level_变量，通过设置debug_level_可以调节debug的层级。该模块中的函数在实际程序中基本上都不会用到，主要使用的以下头文件中定义的宏。

debug.h

1
2
3
4
5
6
7
8
9
10
11
#ifndef __FILE__
#error __FILE__ does not work!
#endif
#ifndef __LINE__
#error __LINE__ does work!
#endif
#define info(unit,format) if(unit<=debug_level_) write(debug_unit(unit), format)
#define error(X) call debug_error(X,__FILE__,__LINE__)
#define assert(X) if(.not.(X)) error('Faild assertation ('//'X'//')')

在该头文件中主要定义了三个宏命令

  • info(unit,format)
    和write(unit,fmt) 的功能一样，但只输出 unit < debug_level_ 的消息，并且当 unit < 1时，输出到 error_unit, 当 0 < unit <= debug_level_ 时，输出到 output_unit.
  • error(X)
    输出出错消息，并自动定位在哪个文件哪一行。
  • assert(X)
    判断 x 是否为真，如果不为真，则输出错误消息。

测试

info

1
2
3
4
5
6
7
8
9
10
11
12
13
#include "debug.h"
program test_info
  use debug  
  implicit none
  integer :: dbg_level = 2
  integer :: l
  call set_debug_level(dbg_level)
  info(l,'(a,i0)') 'debug level is:',dbg_level
  l = 0; info(l,'(a,i0)') 'info level is:',l
  l = 1; info(l,'(a,i0)') 'info level is:',l
  l = 2; info(l,'(a,i0)') 'info level is:',l
  l = 3; info(l,'(a,i0)') 'info level is:',l
end program test_info

结果

1
2
3
4
debug level is: 2
info level is: 0
info level is: 1
info level is: 2

可以看出 level = 3 的info信息没有输出。

error

1
2
3
4
5
program test_error
  use debug  
  implicit none
  error("this is an error.")
end program test_error

结果

1
2
3
# Error
Source loction: (src/test_error.f90, 4 )
Error message : this is an error.

会定位错误出现的文件以及所在行。

assert

1
2
3
4
5
6
program test_assert
  use debug  
  implicit none
  assert(1==1)
  assert(1==2)
end program test_assert

结果

1
2
3
# Error
Source loction: (src/test_assert.f90, 5 )
Error message : Faild assertation (1==2)

可以定位出错未知以及错误信息。

其它

在fortran 中可以通过以下语句来输出错误信息也会定位错误未知，并且会追踪具体出错的地方。

1
2
stop "message"
error stop "error message"